home *** CD-ROM | disk | FTP | other *** search
/ Quick PC 61 / Quick PC 61.iso / I386 / SASETUP.MSI / F77528_autoconfiglang.asp < prev    next >
Encoding:
Text File  |  2003-02-21  |  14.4 KB  |  571 lines
  1. <%    '==================================================
  2.     ' Microsoft Server Appliance
  3.     '
  4.     ' Sets language based on browser settings
  5.     '
  6.     ' Copyright (c) Microsoft Corporation.  All rights reserved.
  7.     '================================================== %>
  8.  
  9. <%
  10. Dim objLocalMgr            
  11. Dim iBrowserLangID
  12.  
  13. Dim arrLangDisplayNames,arrLangISONames, arrLangCharSets
  14. Dim arrLangCodePages, arrLangIDs
  15.  
  16. Const strLANGIDName = "LANGID"
  17. Const ConstDword = 1
  18.  
  19.  
  20. on error resume next
  21. set objLocalMgr = Server.CreateObject("ServerAppliance.LocalizationManager")
  22. If Err.number <> 0 Then
  23.     If ( Err.number = &H800401F3 ) Then
  24.         Response.Write("Unable to locate a software component on the Server Appliance. ")
  25.         Response.Write("The Server Appliance core software components do not appear to be installed correctly.")
  26.             
  27.     Else
  28.         Response.Write("Server.CreateObject(ServerAppliance.LocalizationManager) failed with error code: " + CStr(Hex(Err.Number)) + " " + Err.Description)
  29.     End If
  30.     Call SA_TraceOut("SH_TASK", "Server.CreateObject(ServerAppliance.LocalizationManager) failed with error code: " + CStr(Hex(Err.Number)) )
  31.     Response.End
  32. End If
  33.  
  34. '
  35. ' set the locale EVERYTIME
  36. ' This can cause an error if the LCID is not available, in that case we don't touch the locale
  37. Call SetLCID()
  38.  
  39. on error goto 0
  40.  
  41.  
  42. If Not objLocalMgr.fAutoConfigDone Then
  43.     Dim strBrowserLang
  44.     Dim iCurLang, iCurLangID
  45.  
  46.     on error resume next
  47.     
  48.     iCurLang = objLocalMgr.GetLanguages(arrLangDisplayNames,  arrLangISONames, arrLangCharSets, arrLangCodePages, arrLangIDs)
  49.         
  50.     iCurLangID = arrLangIDs(iCurLang)
  51.  
  52.     'Err.Clear    'Here getting -2147467259  Error
  53.     strBrowserLang = getBrowserLanguage()
  54.     iBrowserLangID = isSupportedLanguage(strBrowserLang)
  55.     
  56.     If  iBrowserLangID <> 0 Then    
  57.         'Browser Language and Current Language "LANGID"  might be diiferent..
  58.         Call ExecuteTask1(Hex(iBrowserLangID), Hex(iCurLangID))
  59.     End if
  60.  
  61.     If SA_IsDebugEnabled() Then
  62.         on error goto 0
  63.     End If
  64.     
  65. End if
  66.  
  67. '
  68. ' set the code page EVERYTIME
  69. '
  70. 'Session.CodePage = objLocalMgr.CurrentCodePage
  71. ' Hard coded for Unicode (UTF-8) codepage
  72. Session.CodePage = 65001
  73.  
  74.  
  75. Set objLocalMgr = Nothing
  76.  
  77. '----------------------------------------------------------------------------
  78. '
  79. ' Function : getBroswerLanguage
  80. '
  81. ' Synopsis : Serves in getting Browser Default Language ID
  82. '
  83. ' Arguments: None
  84. '
  85. ' Returns  : ISO 693 name
  86. '
  87. '----------------------------------------------------------------------------
  88.  
  89. Function getBrowserLanguage
  90.  
  91.     Err.Clear
  92.     Dim strAcceptLanguage
  93.     Dim iPos
  94.   
  95.     strAcceptLanguage = Request.ServerVariables("HTTP_ACCEPT_LANGUAGE")
  96.     iPos = InStr(1, strAcceptLanguage, ",")
  97.     If iPos > 0 Then
  98.         strAcceptLanguage = Left(strAcceptLanguage, iPos - 1)
  99.     End If
  100.  
  101.     getBrowserLanguage = LCase(strAcceptLanguage)
  102. End Function
  103.  
  104.  
  105. '----------------------------------------------------------------------------
  106. '
  107. ' Function : isSupportedLanguage
  108. '
  109. ' Synopsis : checks whether the given language is supported by framework, 
  110. '            if yes returns the lang id else returns 0
  111. '
  112. ' Arguments: strBrowserLang(IN) - ISO Name of Language  
  113. '
  114. ' Returns  : Language ID
  115. '
  116. '----------------------------------------------------------------------------
  117.  
  118. Function isSupportedLanguage(strBrowserLang)
  119.  
  120.     Err.Clear
  121.     
  122.     Dim name
  123.     Dim iIndex
  124.     Dim ISOName
  125.     Dim iLangID    
  126.  
  127.     iIndex=0
  128.     iLangID = 0
  129.  
  130.     '
  131.     '  Chinese Hong Kong or Macau selects Chinese traditional
  132.     '
  133.     If ("zh-hk" = strBrowserLang) Or ("zh-mo" = strBrowserLang) Then
  134.         strBrowserLang = "zh-tw"
  135.     End If
  136.  
  137.     for each ISOName in arrLangISONames
  138.         If ISOName = strBrowserLang Then
  139.             iLangID = arrLangIDs(iIndex)
  140.             Exit for
  141.         End if
  142.         iIndex = iIndex + 1
  143.     next
  144.  
  145. ' If we did not get a match for the full name try the short name
  146.     If ((0 = iLangID) AND (Len(strBrowserLang) > 2)) Then
  147.  
  148.         iIndex=0
  149.         strBrowserLang = Left(strBrowserLang, 2)
  150.  
  151.         for each ISOName in arrLangISONames
  152.             If ISOName = strBrowserLang Then
  153.                 iLangID = arrLangIDs(iIndex)
  154.                 Exit for
  155.             End if
  156.             iIndex = iIndex + 1
  157.         next
  158.     End If
  159.     isSupportedLanguage = iLangID
  160. End Function
  161.  
  162.  
  163. '----------------------------------------------------------------------------
  164. '
  165. ' Function : ExecuteTask1
  166. '
  167. ' Synopsis : Executes the ChangeLanguage task
  168. '
  169. ' Arguments: strLangID(IN) - The LANGID as a string
  170. '         strCurrentLangID(IN) - The current LANGID as a string
  171. '
  172. ' Returns  : true/false for success/failure
  173. '
  174. '----------------------------------------------------------------------------
  175.         
  176. Function ExecuteTask1(ByVal strLangID, ByVal strCurrentLangID)
  177.  
  178.     Err.Clear
  179.     on error resume next
  180.     
  181.     Dim objTaskContext,objAS,rc
  182.     Dim objSL
  183.     Dim sReturnURL
  184.     Dim sURL
  185.     
  186.     
  187.     Const strMethodName = "ChangeLanguage"
  188.     
  189.     Set objTaskContext = CreateObject("Taskctx.TaskContext")
  190.     If Err.Number <> 0 Then
  191.          ExecuteTask1 = FALSE
  192.          Exit Function
  193.     End If
  194.     
  195.     Set objAS = CreateObject("Appsrvcs.ApplianceServices")
  196.     
  197.     If Err.Number <> 0 Then
  198.          ExecuteTask1 = FALSE
  199.          Exit Function
  200.     End If
  201.     
  202.     objTaskContext.SetParameter "Method Name", strMethodName
  203.     objTaskContext.SetParameter "LanguageID", strLANGID
  204.     objTaskContext.SetParameter "AutoConfig", "y"
  205.     
  206.     If Err.Number <> 0 Then
  207.          ExecuteTask1 = FALSE
  208.          Exit Function
  209.     End If
  210.  
  211.     objAS.Initialize()
  212.     If Err.Number <> 0 Then
  213.          ExecuteTask1 = FALSE
  214.          Exit Function
  215.     End If
  216.  
  217.     rc = objAS.ExecuteTask("ChangeLanguage", objTaskContext)
  218.     
  219.     If Err.Number <> 0 Then
  220.          ExecuteTask1 = FALSE
  221.          Exit Function
  222.     End If
  223.     
  224.     'objAS.Shutdown
  225.     'If Err.Number <> 0 Then
  226.     '    If Err.Number <> 438 Then 'error 438  shutdown is not supported..
  227.     '        ExecuteTask1 = FALSE
  228.     '        Exit Function
  229.     '     End if
  230.     'End If
  231.  
  232.     Err.Clear
  233.  
  234.     Set objTaskContext = Nothing
  235.  
  236.     If (strLangID <> strCurrentLangID) Then
  237.  
  238.         Set objSL = Server.CreateObject("SetSystemLocale.SetSystemLocale")
  239.         If Err.Number <> 0 Then
  240.             'SA_TraceOut "autoconfiglang.asp", "Create SetSystemLocale.SetSystemLocale failed: " + CStr(Hex(Err.Number))
  241.             ExecuteTask1 = FALSE
  242.             objAS.Shutdown
  243.             Set objAS = Nothing
  244.             Exit Function
  245.         End If
  246.  
  247.         objSL.SetLocale strLangID
  248.         If ( Err.Number <> 0 ) Then
  249.             'SA_TraceOut "autoconfiglang.asp", "objSL.SetLocale failed"  + CStr(Hex(Err.Number))
  250.             ExecuteTask1 = FALSE
  251.             objAS.Shutdown
  252.             Set objAS = Nothing
  253.             Exit Function
  254.         End If
  255.  
  256.         Set objSL = Nothing
  257.  
  258.         Call RaiseLangChangeAlert(objAS)
  259.         
  260.     End If
  261.  
  262.     objAS.Shutdown
  263.     Set objAS = Nothing
  264.  
  265.     ExecuteTask1 = TRUE
  266.     
  267. End Function 
  268.  
  269.  
  270. Private Function RaiseLangChangeAlert(ByRef oAppServices)
  271.     Err.Clear
  272.     on error resume next
  273.  
  274.     Const SA_ALERT_CLASS = "Microsoft_SA_Resource"
  275.     Const SA_ALERT_DURATION_ETERNAL = 2147483647
  276.     
  277.     Const SA_ALERT_TYPE_WARNING = 0
  278.     Const SA_ALERT_TYPE_FAILURE = 1
  279.     Const SA_ALERT_TYPE_INFORMATION = 2
  280.     
  281.     Const SA_ALERT_NORMAL = 0
  282.     Const SA_ALERT_SINGLETON = 1
  283.     
  284.     Const AUTOLANGCONFIG_LOG = "AutoLangConfig"
  285.     Const AUTOLANGCONFIG_ALERT_RestartRequired = 1
  286.  
  287.  
  288.     Dim rawData
  289.     Dim nullRepStrings
  290.         
  291.  
  292.     '
  293.     ' Raise Alert
  294.     '
  295.     Call oAppServices.RaiseAlertEx(SA_ALERT_TYPE_WARNING, _
  296.                                 AUTOLANGCONFIG_ALERT_RestartRequired, _
  297.                                 AUTOLANGCONFIG_LOG, _
  298.                                 SA_ALERT_CLASS, _
  299.                                 SA_ALERT_DURATION_ETERNAL, _
  300.                                 nullRepStrings, _
  301.                                 rawData, _
  302.                                 SA_ALERT_SINGLETON)
  303.                                     
  304.  
  305. End Function
  306.  
  307. %>
  308.  
  309. <SCRIPT Runat=Server Language=VBScript>
  310. Sub SetLCID()
  311.   Dim strLCID
  312.    
  313.   Select Case getBrowserLanguage
  314.     Case "af"
  315.       strLCID = 1078  ' Afrikaans 
  316.     Case "sq"
  317.       strLCID = 1052  ' Albanian 
  318.     Case "ar-sa"
  319.       strLCID = 1025  ' Arabic(Saudi Arabia) 
  320.     Case "ar-iq"
  321.       strLCID = 2049  ' Arabic(Iraq) 
  322.     Case "ar-eg"
  323.       strLCID = 3073  ' Arabic(Egypt) 
  324.     Case "ar-ly"
  325.       strLCID = 4097  ' Arabic(Libya) 
  326.     Case "ar-dz"
  327.       strLCID = 5121  ' Arabic(Algeria) 
  328.     Case "ar-ma"
  329.       strLCID = 6145  ' Arabic(Morocco) 
  330.     Case "ar-tn"
  331.       strLCID = 7169  ' Arabic(Tunisia) 
  332.     Case "ar-om"
  333.       strLCID = 8193  ' Arabic(Oman) 
  334.     Case "ar-ye"
  335.       strLCID = 9217  ' Arabic(Yemen) 
  336.     Case "ar-sy"
  337.       strLCID = 10241 ' Arabic(Syria) 
  338.     Case "ar-jo"
  339.       strLCID = 11265 ' Arabic(Jordan) 
  340.     Case "ar-lb"
  341.       strLCID = 12289 ' Arabic(Lebanon) 
  342.     Case "ar-kw"
  343.       strLCID = 13313 ' Arabic(Kuwait) 
  344.     Case "ar-ae"
  345.       strLCID = 14337 ' Arabic(U.A.E.) 
  346.     Case "ar-bh"
  347.       strLCID = 15361 ' Arabic(Bahrain) 
  348.     Case "ar-qa"
  349.       strLCID = 16385 ' Arabic(Qatar) 
  350.     Case "eu"
  351.       strLCID = 1069  ' Basque 
  352.     Case "bg"
  353.       strLCID = 1026  ' Bulgarian 
  354.     Case "be"
  355.       strLCID = 1059  ' Belarusian 
  356.     Case "ca"
  357.       strLCID = 1027  ' Catalan 
  358.     Case "zh-tw"
  359.       strLCID = 1028  ' Chinese(Taiwan) 
  360.     Case "zh-cn"
  361.       strLCID = 2052  ' Chinese(PRC) 
  362.     Case "zh-hk"
  363.       strLCID = 3076  ' Chinese(Hong Kong) 
  364.     Case "zh-sg"
  365.       strLCID = 4100  ' Chinese(Singapore) 
  366.     Case "hr"
  367.       strLCID = 1050  ' Croatian 
  368.     Case "cs"
  369.       strLCID = 1029  ' Czech 
  370.     Case "da"
  371.       strLCID = 1030  ' Danish 
  372.     Case "n"
  373.       strLCID = 1043  ' Dutch(Standard) 
  374.     Case "nl-be"
  375.       strLCID = 2067  ' Dutch(Belgian) 
  376.     Case "en"
  377.       strLCID = 1033  ' English 
  378.     Case "en-us"
  379.       strLCID = 1033  ' English(United States) 
  380.     Case "en-gb"
  381.       strLCID = 2057  ' English(British) 
  382.     Case "en-au"
  383.       strLCID = 3081  ' English(Australian) 
  384.     Case "en-ca"
  385.       strLCID = 4105  ' English(Canadian) 
  386.     Case "en-nz"
  387.       strLCID = 5129  ' English(New Zealand) 
  388.     Case "en-ie"
  389.       strLCID = 6153  ' English(Ireland) 
  390.     Case "en-za"
  391.       strLCID = 7177  ' English(South Africa) 
  392.     Case "en-jm"
  393.       strLCID = 8201  ' English(Jamaica) 
  394.     Case "en"
  395.       strLCID = 9225  ' English(Caribbean) 
  396.     Case "en-bz"
  397.       strLCID = 10249 ' English(Belize) 
  398.     Case "en-tt"
  399.       strLCID = 11273 ' English(Trinidad) 
  400.     Case "et"
  401.       strLCID = 1061  ' Estonian 
  402.     Case "fo"
  403.       strLCID = 1080  ' Faeroese 
  404.     Case "fa"
  405.       strLCID = 1065  ' Farsi 
  406.     Case "fi"
  407.       strLCID = 1035  ' Finnish 
  408.     Case "fr"
  409.       strLCID = 1036  ' French(Standard) 
  410.     Case "fr-be"
  411.       strLCID = 2060  ' French(Belgian) 
  412.     Case "fr-ca"
  413.       strLCID = 3084  ' French(Canadian) 
  414.     Case "fr-ch"
  415.       strLCID = 4108  ' French(Swiss) 
  416.     Case "fr-lu"
  417.       strLCID = 5132  ' French(Luxembourg) 
  418.     Case "gd"
  419.       strLCID = 1084  ' Gaelic(Scots) 
  420.     Case "gd-ie"
  421.       strLCID = 2108  ' Gaelic(Irish) 
  422.     Case "de"
  423.       strLCID = 1031  ' German(Standard) 
  424.     Case "de-ch"
  425.       strLCID = 2055  ' German(Swiss) 
  426.     Case "de-at"
  427.       strLCID = 3079  ' German(Austrian) 
  428.     Case "de-lu"
  429.       strLCID = 4103  ' German(Luxembourg) 
  430.     Case "de-li"
  431.       strLCID = 5127  ' German(Liechtenstein) 
  432.     Case "e"
  433.       strLCID = 1032  ' Greek 
  434.     Case "he"
  435.       strLCID = 1037  ' Hebrew 
  436.     Case "hi"
  437.       strLCID = 1081  ' Hindi 
  438.     Case "hu"
  439.       strLCID = 1038  ' Hungarian 
  440.     Case "is"
  441.       strLCID = 1039  ' Icelandic 
  442.     Case "in"
  443.       strLCID = 1057  ' Indonesian 
  444.     Case "it"
  445.       strLCID = 1040  ' Italian(Standard) 
  446.     Case "it-ch"
  447.       strLCID = 2064  ' Italian(Swiss) 
  448.     Case "ja"
  449.       strLCID = 1041  ' Japanese 
  450.     Case "ko"
  451.       strLCID = 1042  ' Korean 
  452.     Case "ko"
  453.       strLCID = 2066  ' Korean(Johab) 
  454.     Case "lv"
  455.       strLCID = 1062  ' Latvian 
  456.     Case "lt"
  457.       strLCID = 1063  ' Lithuanian 
  458.     Case "mk"
  459.       strLCID = 1071  ' Macedonian 
  460.     Case "ms"
  461.       strLCID = 1086  ' Malaysian 
  462.     Case "mt"
  463.       strLCID = 1082  ' Maltese 
  464.     Case "no"
  465.       strLCID = 1044  ' Norwegian(Bokmal) 
  466.     Case "no"
  467.       strLCID = 2068  ' Norwegian(Nynorsk) 
  468.     Case "p"
  469.       strLCID = 1045  ' Polish 
  470.     Case "pt-br"
  471.       strLCID = 1046  ' Portuguese(Brazilian) 
  472.     Case "pt"
  473.       strLCID = 2070  ' Portuguese(Standard) 
  474.     Case "rm"
  475.       strLCID = 1047  ' Rhaeto-Romanic 
  476.     Case "ro"
  477.       strLCID = 1048  ' Romanian 
  478.     Case "ro-mo"
  479.       strLCID = 2072  ' Romanian(Moldavia) 
  480.     Case "ru"
  481.       strLCID = 1049  ' Russian 
  482.     Case "ru-mo"
  483.       strLCID = 2073  ' Russian(Moldavia) 
  484.     Case "sz"
  485.       strLCID = 1083  ' Sami(Lappish) 
  486.     Case "sr"
  487.       strLCID = 3098  ' Serbian(Cyrillic) 
  488.     Case "sr"
  489.       strLCID = 2074  ' Serbian(Latin) 
  490.     Case "sk"
  491.       strLCID = 1051  ' Slovak 
  492.     Case "s"
  493.       strLCID = 1060  ' Slovenian 
  494.     Case "sb"
  495.       strLCID = 1070  ' Sorbian 
  496.     Case "es"
  497.       strLCID = 1034  ' Spanish(Spain - Traditional Sort) 
  498.     Case "es-mx"
  499.       strLCID = 2058  ' Spanish(Mexican) 
  500.     Case "es"
  501.       strLCID = 3082  ' Spanish(Spain - Modern Sort) 
  502.     Case "es-gt"
  503.       strLCID = 4106  ' Spanish(Guatemala) 
  504.     Case "es-cr"
  505.       strLCID = 5130  ' Spanish(Costa Rica) 
  506.     Case "es-pa"
  507.       strLCID = 6154  ' Spanish(Panama) 
  508.     Case "es-do"
  509.       strLCID = 7178  ' Spanish(Dominican Republic) 
  510.     Case "es-ve"
  511.       strLCID = 8202  ' Spanish(Venezuela) 
  512.     Case "es-co"
  513.       strLCID = 9226  ' Spanish(Colombia) 
  514.     Case "es-pe"
  515.       strLCID = 10250 ' Spanish(Peru) 
  516.     Case "es-ar"
  517.       strLCID = 11274 ' Spanish(Argentina) 
  518.     Case "es-ec"
  519.       strLCID = 12298 ' Spanish(Ecuador) 
  520.     Case "es-c"
  521.       strLCID = 13322 ' Spanish(Chile) 
  522.     Case "es-uy"
  523.       strLCID = 14346 ' Spanish(Uruguay) 
  524.     Case "es-py"
  525.       strLCID = 15370 ' Spanish(Paraguay) 
  526.     Case "es-bo"
  527.       strLCID = 16394 ' Spanish(Bolivia) 
  528.     Case "es-sv"
  529.       strLCID = 17418 ' Spanish(El Salvador) 
  530.     Case "es-hn"
  531.       strLCID = 18442 ' Spanish(Honduras) 
  532.     Case "es-ni"
  533.       strLCID = 19466 ' Spanish(Nicaragua) 
  534.     Case "es-pr"
  535.       strLCID = 20490 ' Spanish(Puerto Rico) 
  536.     Case "sx"
  537.       strLCID = 1072  ' Sutu 
  538.     Case "sv"
  539.       strLCID = 1053  ' Swedish 
  540.     Case "sv-fi"
  541.       strLCID = 2077  ' Swedish(Finland) 
  542.     Case "th"
  543.       strLCID = 1054  ' Thai 
  544.     Case "ts"
  545.       strLCID = 1073  ' Tsonga 
  546.     Case "tn"
  547.       strLCID = 1074  ' Tswana 
  548.     Case "tr"
  549.       strLCID = 1055  ' Turkish 
  550.     Case "uk"
  551.       strLCID = 1058  ' Ukrainian 
  552.     Case "ur"
  553.       strLCID = 1056  ' Urdu 
  554.     Case "ve"
  555.       strLCID = 1075  ' Venda 
  556.     Case "vi"
  557.       strLCID = 1066  ' Vietnamese 
  558.     Case "xh"
  559.       strLCID = 1076  ' Xhosa 
  560.     Case "ji"
  561.       strLCID = 1085  ' Yiddish 
  562.     Case "zu"
  563.       strLCID = 1077  ' Zulu 
  564.     Case Else
  565.       strLCID = 2048  ' default
  566.   End Select 
  567.  
  568.   Session.LCID = strLCID
  569. End Sub
  570. </SCRIPT> 
  571.